package Waya::Board;

use warnings;
use strict;
use Waya::Coordinate;
use Waya::Constants ':colors';

use base 'Waya::Base';

# This class represents a go board. It keeps track of the stones currently on
# the board in the two-dimensional array board().

__PACKAGE__
    ->mk_array_accessors(qw(board))
    ->mk_scalar_accessors(qw(board_size));


use constant DEFAULTS => (
    board_size => 19,
);


# Returns the coordinates of the four intersections (three at the side, two in
# the corner) adjacent to the given intersection. Coordinates are represented
# by a Waya::Coordinate object.

sub neighbors {
    my ($self, $coord) = @_;
    my @l;
    my %map = ( x => 0, y => 1 );
    while (my ($accessor, $index) = each %map) {
        if ($coord->$accessor == 1) {
            $l[$index] = [ 2 ];
        } elsif ($coord->$accessor == $self->board_size) {
            $l[$index] = [ $self->board_size - 1 ];
        } else {
            $l[$index] = [ $coord->$accessor - 1, $coord->$accessor + 1 ];
        }
    }
    my @neighbor =
        ((map { Waya::Coordinate->new(x => $_, y => $coord->y) } @{$l[0]}),
         (map { Waya::Coordinate->new(x => $coord->x, y => $_) } @{$l[1]})
        );
    wantarray ? @neighbor : \@neighbor;
}


sub clear {
    my $self = shift;
    $self->board_clear;
}


sub stone_at_coord {
    my ($self, $coord) = @_;
    $self->board->[$coord->x][$coord->y];
}


sub place_stone_at_coord {
    my ($self, $coord, $color) = @_;
    $self->board->[$coord->x][$coord->y] = $color;
}


sub remove_stone_at_coord {
    my ($self, $coord) = @_;
    delete $self->board->[$coord->x][$coord->y];
}


# Plays a stone of the specified color at coord, if that is a legal move
# (disregarding ko), and deletes stones captured by that move. Returns a true
# value if the move has been played, a false value if not.

sub play {
    my ($self, $coord, $color) = @_;

    # check if empty
    return if $self->stone_at_coord($coord);

    # legal move?
    my $result = $self->legal($coord, $color);
    return unless defined $result;

    # remove captured stones, if any
    $self->remove_stone_at_coord($_) for @$result;
    return 1;
}


sub invert {
    my ($self, $color) = @_;
    $color eq BLACK ? WHITE : BLACK;
}


# Check if a play by color at coord would be a legal move.

sub legal {
    my ($self, $coord, $color) = @_;
    my @captured;
    for my $neighbor ($self->neighbors($coord)) {
        my $stone = $self->stone_at_coord($neighbor);

        # check each neighboring stone of the opposite color whether it is
        # captured

        if ((defined $stone) && $stone eq $self->invert($color)) {
            push @captured => $self->group_without_liberties($neighbor, $coord);
        }
    }

    # make the list of captured stones unique (could contain duplicates)
    my %captured;
    $captured{"$_"} = $_ for @captured;
    @captured = values %captured;

    # If the stone played captured something then it's legal; we place the
    # stone and return the list of captured stones.

    # Place the stone now so that the following call to
    # group_without_liberties() can see the stone.

    $self->place_stone_at_coord($coord, $color);
    return \@captured if @captured;

    # If the stone played didn't capture anything and it doesn't have any
    # liberties, then it is not legal and we return an undef value.

    if (scalar $self->group_without_liberties($coord)) {
        $self->remove_stone_at_coord($coord);
    }

    # Otherwise the stone played didn't capture anything, but it has
    # liberties, so place the stone and return the empty list.

    return [];
}


# This function checks if the string (= solidly connected) of stones
# containing the stone at coord has a liberty; if exclude is given, it checks
# whether the stone has a liberty besides that at exclude. If no liberties are
# found, a list of all stones in the string is returned.

# The algorithm is a non-recursive implementation of a simple flood-filling:
# starting from the stone at pos, the main while-loop looks at the
# intersections directly adjacent to the stones found so far, for liberties or
# other stones that belong to the string. Then it looks at the neighbors of
# those newly found stones, and so on, until it finds a liberty, or until it
# doesn't find any new stones belonging to the string, which means that there
# are no liberties.

# Once a liberty is found, the function returns immediately.
        
sub group_without_liberties {
    my ($self, $coord, $exclude) = @_;
    
    # In the end, values(%group) will contain all stones solidly connected to
    # the one at coord, if this string has no liberties. Stored as a hash so
    # we avoid duplicates.

    my %group;

    # In the while loop, we will look at the neighbors of stones in
    # newly_found. Also stored as a hash to avoid duplicates.

    my %newly_found = ($coord => $coord);
    my $found_new = 1;

    while ($found_new) {
        $found_new = 0;
        my %iter_found;   # will contain the stones found in this iteration
        for my $coord (values %newly_found) {
            for my $neighbor ($self->neighbors($coord)) {

                my $neighbor_stone = $self->stone_at_coord($neighbor);

                if (defined $neighbor_stone) {
                    if ($neighbor_stone eq $self->stone_at_coord($coord) &&
                        !exists($group{$neighbor}) &&
                        !exists($newly_found{$neighbor})) {

                        # found another stone of the same color

                        $iter_found{$neighbor} = $neighbor;
                        $found_new = 1;
                    }
                } else {
                    # This neighbor is empty, i.e. we found a liberty. Return
                    # the empty list if this liberty is not the excluded one,
                    # or if there is no excluded liberty.

                    return () unless defined $exclude;
                    return () if $neighbor ne $exclude;
                }
            }
        }

        %group = (%group, %newly_found);
        %newly_found = %iter_found;
    }

    # No liberties found, return list of all stones connected to the original
    # one.

    return values %group;
}


sub dump {
    my $self = shift;
    for my $y (1..$self->board_size) {
        for my $x (1..$self->board_size) {
            my $stone = $self->stone_at_coord(
                Waya::Coordinate->new(x => $x, y => $y)
            );
            if (!defined $stone) {
                print '. '
            } elsif ($stone eq BLACK) {
                print 'X ';
            } elsif ($stone eq WHITE) {
                print 'O ';
            } else {
                print '? ';
            }
        }
        print "\n";
    }
}


1;

